Entrega grupal
- Hemos descubierto que las diferencias principales están en CIU y UP en 2015.
Resumenle da 630.000 votos a CIU, peroresumen2solo 65.000, según la web del ministerio del interior obtuvieron 567.000 1
En cuanto a los votos en 2015 para UP, si se suman los de Podemos, Coalición “En Comú Podem”, Coalición “Unidad Popular” y Coalición “Compromís - Podemos - És el Moment”, el ministerio de interior dice que obtuvieron 5.700.000 votos, muy cercano al cálculo de
resumen, mientras queresumen2se queda 500.00 votos corto.Y parecido ocurre para el año 2016 para UP:
resumen4.700.000 vsresumen24.200.000 vs ministerio 5.000.000.Por tanto creemos que la agrupación
resumenes más precisa y es la que usaremos para el resto del trabajo.
Pregunta_1
¿Qué partido fue el ganador en los municipios con más de 100.000 habitantes (censo) en cada una de las elecciones?
Pregunta_2
¿Qué partido fue el segundo cuando el primero fue el PSOE? ¿Y cuando el primero fue el PP?
# manera 1
primeros_segundos <-
segundos |>
group_by(fecha) |>
mutate(rank = row_number()) |> # Clasificar partidos por votos en cada año
filter(rank <= 2) |> # Filtrar los dos partidos principales de cada año
summarise(
primero = siglas[rank == 1], # partido en primer lugar
votos_1 = total_votos[rank == 1], # Número de votos del primer lugar
segundo = siglas[rank == 2], # partido en segundo lugar
votos_2 = total_votos[rank == 2] # Número de votos del segundo lugar
) |>
ungroup()
#Otra manera comparando la participación de los distintos años
#Calculamos la participación total por año, a nivel nacional
participacion_anual <- resumen |> group_by(fecha) |>
summarise(participacion_total = sum(votos, na.rm = TRUE))
media_votos_años <-
mean(participacion_anual$participacion_total)
#Clasificamos los años según si la participación ha sido más alta de lo normal, media o más baja
participacion_anual <- participacion_anual |>
mutate(categoria_participacion = case_when(
participacion_total < media_votos_años ~ "Baja_participacion",
participacion_total >= media_votos_años ~ "Alta_participacion" ))
#Calculamos los votos históricos por partido
totales_partido <- resumen |> group_by(siglas) |>
summarise(votos_totales = sum(votos, na.rm = TRUE))
#Participación relativa por partido y año
participacion_partido <- resumen |> group_by(fecha, siglas) |>
summarise(votos_partido = sum(votos, na.rm = TRUE), .groups = "drop") |>
left_join(participacion_anual, by = "fecha") |>
left_join(totales_partido, by = "siglas") |>
mutate(participacion_relativa = votos_partido / participacion_total)
#en esta tabla tenemos votos_partido que son los votos de ese partido en esa elección
#participación_total es el total de votos de la elección de ese año, todos los votantes
#votos_totales son el total de votos que ha conseguido cada partido en todas las elecciones, suma todos los votos que ha tenido a lo largo de los años
#participación_relativa es el total de votos del partido ese año entre el total de votos habidos en esas elecciones
#Analizamos el beneficio por tipo de participación
comparacion <- participacion_partido |>
filter(categoria_participacion %in% c("Baja_participacion", "Alta_participacion")) |>
group_by(siglas,
categoria_participacion) |>
summarise(promedio_participacion = mean(participacion_relativa, na.rm = TRUE), .groups = "drop") |>
pivot_wider(names_from = categoria_participacion,
values_from = promedio_participacion) |>
mutate(beneficio_baja = Baja_participacion - Alta_participacion) |>
arrange(desc(beneficio_baja))
# Con el beneficio_baja sacamos la diferencia de porcentaje de votos de cada partido que han tenido los años de elecciones con naja participación entre los años de alta participación
# Los partidos donde beneficio_baja es positivo, significa que salen ganando cuando hay baja participación
#Los partidos con beneficio_baja negativo, significa que pierden votos cuando la participación es alta en las elecciones
Pregunta_4
- ¿Cómo analizar la relación entre censo y voto? ¿Es cierto que determinados partidos ganan en las zonas rurales?
Code
# ANALIZANDO RELACIÓN ENTRE CENSO Y VOTO
# Calculamos el total de votos por municipio y por fecha electoral
relacion_censo_votos <-
resumen |>
group_by(fecha, id_municipio, censo) |>
summarise(Total_votos = sum(votos), .groups = "drop")
# Calcular la correlación entre censo y votos totales
correlacion_1 <-
cor(relacion_censo_votos$censo, relacion_censo_votos$Total_votos)
print(paste("Correlación entre censo y votos totales:",
round(correlacion_1, 2)))[1] "Correlación entre censo y votos totales: 1"Code
# Visualizar la correlación
ggplot(relacion_censo_votos,
aes(x = censo, y = Total_votos)) +
geom_point(alpha = 0.7, color = "#F4A460", size = 1.3) +
geom_smooth(method = "lm",
color = "#5F4B8B",
linewidth = 1,
se = FALSE) +
labs(
title = "Relación entre censo y votos totales",
subtitle = paste("Correlación:", round(correlacion_1, 2)),
x = "Censo (personas censadas)",
y = "Votos totales"
) +
theme_minimal(base_family = "Rockwell")+
theme(plot.title = element_text(size = 18,face = "bold", hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5))
- ¿Es cierto que determinados partidos ganan en las zonas rurales?
Code
# ANALIZANDO SI CIERTOS PARTIDOS GANAN MÁS EN ZONAS RURALES QUE EN ZONAS URBANAS
# Creamos una tabla en donde guardamos el tipo de zona según el censo: Rural o Urbano
rurales_urbanas <-
resumen |>
mutate("Zona" = ifelse(censo < 10000,
"Rural",
"Urbano"))
# Calculamos los votos de cada partido para cada tipo de zona en cada elección
votos_por_zona <-
rurales_urbanas |>
group_by(fecha, Zona, siglas) |>
summarise(Total_votos = sum(votos),
.groups = "drop")
# Creamos el gráfico que muestre las diferencias entre partidos, tipos de zona y fechas de elecciones
ggplot(votos_por_zona,
aes(x = siglas, y = Total_votos, fill = Zona)) +
geom_bar(stat = "identity", position = position_dodge(width = 0.5)) +
facet_wrap(~ fecha, ncol = 2) + # Dividir gráficos por fecha de elección
scale_fill_manual(values = c("Rural" = "#1EC2F3", "Urbano" = "#7C20E9"))+
labs(
title = "
Comparación de votos por partido entre zonas rurales y urbanas",
x = "Siglas",
y = "Total de Votos",
fill = "Zona") +
theme_minimal(base_family = "Rockwell") +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
plot.title = element_text(size = 18,face = "bold", hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5) )Code
# Como era de esperar, nos salen 6 gráficos (uno por cada fecha electoral) pero el problema es que puede ser bastante complicado de entender a la hora de exponerlo. Es por ello que creo conveniente poner 3 gráficos pero por separados que muestren cómo ha ido evolucionando los votos a lo largo del tiempo, por ejemplo el gráfico del 2008, el del 2016 y el del 2019
# GRÁFICOS 2008, 2016 Y 2019
# 2008
votos_por_zona_2008 <-
rurales_urbanas |>
filter(fecha == "2008-03-01") |>
group_by(Zona, siglas) |>
summarise(Total_votos = sum(votos), .groups = "drop")
zona_2008 <-
ggplot(votos_por_zona_2008, aes(x = siglas, y = Total_votos, fill = Zona)) +
geom_bar(stat = "identity", position = position_dodge(width = 0.5)) +
scale_fill_manual(values = c("Rural" = "#1EC2F3", "Urbano" = "#7C20E9")) +
labs(
title = "
Comparación de votos por partido entre zonas rurales y urbanas",
subtitle = "Fecha: Marzo de 2008",
x = "Siglas",
y = "Total de Votos",
fill = "Zona"
) +
theme_minimal(base_family = "Rockwell") +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
plot.title = element_text(size = 18,face = "bold", hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5))
# 2016
votos_por_zona_2016 <-
rurales_urbanas |>
filter(fecha == "2016-06-01") |>
group_by(Zona, siglas) |>
summarise(Total_votos = sum(votos), .groups = "drop")
zona_2016 <-
ggplot(votos_por_zona_2016, aes(x = siglas, y = Total_votos, fill = Zona)) +
geom_bar(stat = "identity", position = position_dodge(width = 0.5)) +
scale_fill_manual(values = c("Rural" = "#1EC2F3", "Urbano" = "#7C20E9")) +
labs(
title = "
Comparación de votos por partido entre zonas rurales y urbanas",
subtitle = "Fecha: Junio de 2016",
x = "Siglas",
y = "Total de Votos",
fill = "Zona"
) +
theme_minimal(base_family = "Rockwell") +
theme(axis.text.x = element_text(angle = 45,
hjust = 1),
plot.title = element_text(size = 18,face = "bold", hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5))
# 2019 (la última)
votos_por_zona_2019 <-
rurales_urbanas |>
filter(fecha == "2019-11-01") |>
group_by(Zona, siglas) |>
summarise(Total_votos = sum(votos),
.groups = "drop")
zona_2019 <-
ggplot(votos_por_zona_2019, aes(x = siglas,
y = Total_votos,
fill = Zona)) +
geom_bar(stat = "identity", position = position_dodge(width = 0.5)) +
scale_fill_manual(values = c("Rural" = "#1EC2F3", "Urbano" = "#7C20E9")) +
labs(
title = "
Comparación de votos por partido entre zonas rurales y urbanas",
subtitle = "Fecha: Noviembre de 2019",
x = "Siglas",
y = "Total de Votos",
fill = "Zona"
) +
theme_minimal(base_family = "Rockwell") +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
plot.title = element_text(size = 18,face = "bold", hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5))
Pregunta_6
¿Qué casas encuestadoras acertaron más y cuáles se desviaron más de los resultados?
# Paso 1: Calcular el error absoluto para cada encuesta
datos_combinados <- casas_encuestadoras |>
rename(siglas = partidos) |>
inner_join(resultados, by = c("fecha", "siglas")) |>
mutate(error_absoluto = abs(porcentaje_estimado - Porcentaje_real))
# Paso 2: Calcular el error promedio por casa encuestadora
error_por_casa <- datos_combinados |>
group_by(pollster) |>
summarise(error_medio = mean(error_absoluto, na.rm = TRUE)) |>
arrange(error_medio)
# Paso 3: Identificar la casa encuestadora más precisa y la que más se desvió
casa_mas_precisa <-
error_por_casa |> slice_min(error_medio)
casa_mas_desviada <-
error_por_casa |> slice_max(error_medio)
# Visualización de resultados
lista <- list(Error_Promedio_Por_Casa = error_por_casa, Casa_Mas_Precisa = casa_mas_precisa,Casa_Mas_Desviada = casa_mas_desviada)
Pregunta_7
- Sabemos que en 2019 se realizaron 2 elecciones pero ¿hubo diferencias en el total de gente que asistió a votar?. ¿Que partidos ganaron votos en la segunda ronda y cuales salieron perdiendo?
Code
# Filtrar solo las elecciones que ocurrieron en 2019
eleccion_2019 <-resumen |>
filter(year(fecha) == 2019)
# Calculamos la participación total por elección, observamos que en la realizada en abril hay cerca de 2 millones más de votantes que en la de finales del mismo año
participacion_2019 <- eleccion_2019 |>
group_by(fecha) |>
summarise(participacion_total = sum(votos, na.rm = TRUE)) |>
arrange(fecha)Code
# Comparamos los votos de cada partido en las dos elecciones de 2019
votos_2019 <- eleccion_2019 |>
group_by(fecha, siglas) |>
summarise(votos_totales = sum(votos, na.rm = TRUE), .groups = "drop") |>
pivot_wider(names_from = fecha, values_from = votos_totales) |>
mutate(diferencia_votos = `2019-11-01` - `2019-04-01`) |>
arrange(desc(diferencia_votos))
#Esto nos devuelve una tabla con los votos de cada grupo de siglas, una columna con la primera elección y otra con la segunda. al final tenemos una tercera columna con la diferencia de votos entre elecciones, los positivos son los partidos que ganaron votos y los negativos los que perdieron electores
Code
#Ahora unos gráficos para observar visualmente las diferencias entre sufragios
max_part <-
max(participacion_2019$participacion_total,
na.rm = TRUE)
ggplot(participacion_2019,
aes(x = as.factor(fecha),
y = participacion_total,
fill = as.factor(fecha))) +
geom_bar(stat = "identity",
show.legend = FALSE,
width = 0.6,
alpha = 0.9) +
scale_fill_manual(values = c("#D72638", "#6A4C93")) +
labs(
title = "Participación total en las elecciones de 2019",
subtitle = "Comparación entre fechas de elecciones",
x = "Fecha de Elección",
y = "Total de Votantes (en millones)"
) +
theme_minimal(base_family = "Rockwell")+
scale_y_continuous(breaks = seq(0, max_part, by = 2e6),
labels = scales::label_number(scale = 1e-6, suffix = "M"))+
theme(plot.title = element_text(size = 18,face = "bold", hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5))
Code
# Gráfico de diferencias de votos por partido
max_dif <-
max(abs(votos_2019$diferencia_votos),
na.rm = TRUE)
ggplot(votos_2019,
aes(x = reorder(siglas, diferencia_votos),
y = diferencia_votos,
fill = diferencia_votos > 0)) +
geom_bar(stat = "identity",
show.legend = FALSE) +
labs(title = "Diferencia de votos por partido entre abril y noviembre de 2019",
x = "Partido",
y = "Diferencia de Votos") +
theme_minimal(base_family = "Rockwell") +
scale_fill_manual(values = c("#E57373", "#81C784")) + # Rojo para pérdidas, verde para ganancias
scale_y_continuous(
breaks = seq(-max_dif, max_dif, by = 500000), # Intervalos de 2M
labels = scales::label_number(scale = 1e-6, suffix = "M") # Convertir a millones
) +
coord_flip() +# Para que el gráfico sea horizontal
theme(plot.title = element_text(size = 18,face = "bold", hjust = 0.5))
Code
#Gráfico superpuesto con los votos en columnas de cada partido
votos_2019_long_temp <-
votos_2019 |>
pivot_longer(cols = -c(siglas, diferencia_votos), # Mantener siglas y diferencia_votos, convertir las fechas
names_to = "fecha",
values_to = "votos_totales")
votos_2019_long <-
votos_2019_long_temp |>
group_by(siglas) |>
summarise(total_votos = sum(votos_totales,
na.rm = TRUE)) |>
right_join(votos_2019_long_temp, by = "siglas") |>
mutate(siglas = fct_reorder(siglas,
total_votos,
.desc = TRUE))
ggplot(votos_2019_long,
aes(x = siglas,
y = votos_totales,
fill = as.factor(fecha))) +
geom_col(position = "identity", alpha = 0.8) + # Superponer barras con transparencia
labs(title = "Comparación de votos por partido en las elecciones de 2019",
x = "Partido",
y = "Total de Votos",
fill = "Fecha de elección") +
theme_minimal(base_family = "Rockwell") +
scale_fill_manual(values = c("#D72638", "#6A4C93")) + # Azul para abril, naranja para noviembre
scale_y_continuous(
labels = scales::label_number(scale = 1e-6, suffix = "M") # Convertir a millones
) +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
plot.title = element_text(size = 18,face = "bold", hjust = 0.5))
ggplot(mapa_datos) +
geom_sf(aes(fill = partido_ganador, alpha = participacion), color = "white", size = 0.2) + scale_fill_manual(values = colores, name = "Partido Ganador")+ facet_wrap(~fecha)+
labs(title = "Ganadores y Participación por Provincia en España",
subtitle = "Alpha representa la participación") +
guides(alpha = "none")+
theme_minimal(base_family = "Rockwell")+
theme(plot.title = element_text(size = 18,face = "bold", hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5))
Code
tabla_ajustada <- tabla_comp |> group_by(fecha) |>
mutate(
suma_nacional = sum(pct_voto_nacional),
faltante = 100 - suma_nacional, # Porcentaje faltante
proporcion = pct_voto_nacional / suma_nacional, # Proporción de cada partido
ajuste = proporcion * faltante, # Ajuste proporcional
pct_voto_nacional_ajustado = pct_voto_nacional + ajuste # Nuevo porcentaje ajustado
) |>
mutate(dif=pct_voto_local-pct_voto_nacional_ajustado) |>
ungroup() |>
select(fecha, siglas, pct_voto_local, pct_voto_nacional_ajustado, dif)
# Gráfico de las diferencias
orden_leyenda <- c("PSOE", "PP", "UP","Cs","VOX", "ERC", "PNV", "CIU", "BNG", "EH-BILDU", "MP", "OTROS")Code
tabla_ajustada <- tabla_ajustada |>
mutate(
siglas = factor(siglas, levels = orden_leyenda),
fecha_formateada = factor(format(as.Date(fecha), "%b %Y"), levels = format(sort(unique(as.Date(fecha))), "%b %Y"))
) |> arrange(fecha_formateada)
titulo<-glue("Diferencia entre Porcentajes de Votos ({muni} - Nacional)")
gg<- ggplot(tabla_ajustada, aes(x = factor(fecha_formateada), y = dif, fill = siglas)) +
geom_bar(stat = "identity", position = "dodge") + # Barras lado a lado
labs(
title = titulo,
x = "",
y = "",
fill = ""
) +
scale_fill_manual(values = colores) + # Colores personalizados
theme_minimal() +
theme(
axis.text.x = element_text(angle = 45, hjust = 1), # Rotar etiquetas del eje X
strip.text = element_text(size = 10), # Tamaño de los títulos en los paneles
panel.spacing = unit(1, "lines") # Espaciado entre paneles
)
Pregunta_10
